winLocker takelock _ (Just lockfile) =
let lck = do
modifyContentDir lockfile $
- void $ liftIO $ tryIO $
- writeFile (fromOsPath lockfile) ""
+ void $ liftIO $ tryIO $ writeFileString lockfile ""
liftIO $ takelock lockfile
in (lck, Nothing)
-- never reached; windows always uses a separate lock file
-- clean up gitAnnexTmpWorkDir for those it finds.
obj <- prepTmp key
unlessM (liftIO $ doesFileExist obj) $ do
- liftIO $ writeFile (fromOsPath obj) ""
+ liftIO $ writeFileString obj ""
setAnnexFilePerm obj
let tmpdir = gitAnnexTmpWorkDir obj
createAnnexDirectory tmpdir
readContentRetentionTimestamp rt >>= \case
Just ts | ts >= t -> return ()
_ -> replaceFile (const noop) rt $ \tmp ->
- liftIO $ writeFile (fromOsPath tmp) $ show t
+ liftIO $ writeFileString tmp $ show t
where
lock = takeExclusiveLock
unlock = liftIO . dropLock
{- git-annex repository fixups
-
- - Copyright 2013-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2025 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Annex.Fixup where
+import Common
import Git.Types
import Git.Config
import Types.GitConfig
-import Utility.Path
-import Utility.Path.AbsRel
-import Utility.SafeCommand
-import Utility.Directory
-import Utility.Exception
-import Utility.Monad
-import Utility.SystemDirectory
-import Utility.OsPath
import qualified Utility.RawFilePath as R
-import Utility.PartialPrelude
import qualified Utility.OsString as OS
-import System.IO
-import Data.List
-import Data.Maybe
-import Control.Monad
-import Control.Monad.IfElse
import qualified Data.Map as M
-import Control.Applicative
-import Prelude
fixupRepo :: Repo -> GitConfig -> IO Repo
fixupRepo r c = do
-- git-worktree sets up a "commondir" file that contains
-- the path to the main git directory.
-- Using --separate-git-dir does not.
- commondirfile = fromOsPath (d </> literalOsPath "commondir")
+ commondirfile = d </> literalOsPath "commondir"
readcommondirfile = catchDefaultIO Nothing $
fmap toOsPath . headMaybe . lines
- <$> readFile commondirfile
+ <$> readFileString commondirfile
setworktreepath r' = readcommondirfile >>= \case
Just gd -> return $ r'
readProgramFile :: IO (Maybe OsPath)
readProgramFile = catchDefaultIO Nothing $ do
programfile <- programFile
- fmap toOsPath . headMaybe . lines <$> readFile (fromOsPath programfile)
+ fmap toOsPath . headMaybe . lines <$> readFileString programfile
cannotFindProgram :: IO a
cannotFindProgram = do
let st'' = st'
{ simRepoState = M.map freeze (simRepoState st')
}
- let statefile = fromOsPath $
- toOsPath (simRootDirectory st'') </> literalOsPath "state"
- writeFile statefile (show st'')
+ let statefile = toOsPath (simRootDirectory st'') </> literalOsPath "state"
+ writeFileString statefile (show st'')
where
freeze :: SimRepoState SimRepo -> SimRepoState ()
freeze rst = rst { simRepo = Nothing }
restoreSim :: OsPath -> IO (Either String (SimState SimRepo))
restoreSim rootdir =
- tryIO (readFile statefile) >>= \case
+ tryIO (readFileString statefile) >>= \case
Left err -> return (Left (show err))
Right c -> case readMaybe c :: Maybe (SimState ()) of
Nothing -> return (Left "unable to parse sim state file")
}
return (Right st'')
where
- statefile = fromOsPath $ rootdir </> literalOsPath "state"
+ statefile = rootdir </> literalOsPath "state"
thaw st (u, rst) = tryNonAsync (thaw' st u) >>= return . \case
Left _ -> (u, rst { simRepo = Nothing })
Right r -> (u, rst { simRepo = Just r })
sshAskPassEnv = "GIT_ANNEX_SSHASKPASS"
runSshAskPass :: FilePath -> IO ()
-runSshAskPass passfile = putStrLn =<< readFile passfile
+runSshAskPass passfile = putStrLn =<< readFileString (toOsPath passfile)
nofiles = Left $ youtubeDlCommand ++ " did not put any media in its work directory, perhaps it's been configured to store files somewhere else?"
toomanyfiles fs = Left $ youtubeDlCommand ++ " downloaded multiple media files; git-annex is only able to deal with one per url: " ++ show fs
downloadedfiles = liftIO $
- (nub . lines <$> readFile (fromOsPath filelistfile))
+ (nub . lines <$> readFileString filelistfile)
`catchIO` (pure . const [])
workdirfiles = liftIO $ filter (/= filelistfile)
<$> (filterM doesFileExist =<< dirContents workdir)
]
readDaemonStatusFile :: FilePath -> IO DaemonStatus
-readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFile file
+readDaemonStatusFile file = parse <$> newDaemonStatus <*> readFileString (toOsPath file)
where
parse status = foldr parseline status . lines
parseline line status
let program = base </> literalOsPath "git-annex"
programfile <- programFile
createDirectoryIfMissing True (parentDir programfile)
- writeFile (fromOsPath programfile) (fromOsPath program)
+ writeFileString programfile (fromOsPath program)
#ifdef darwin_HOST_OS
autostartfile <- userAutoStart osxAutoStartLabel
let bootfile = toOsPath home </> literalOsPath ".termux" </> literalOsPath "boot" </> literalOsPath "git-annex"
unlessM (doesFileExist bootfile) $ do
createDirectoryIfMissing True (takeDirectory bootfile)
- writeFile (fromOsPath bootfile) "git-annex assistant --autostart"
+ writeFileString bootfile "git-annex assistant --autostart"
, do
menufile <- desktopMenuFilePath "git-annex" <$> userDataDir
icondir <- iconDir <$> userDataDir
userdata <- userDataDir
let kdeServiceMenusdir = userdata </> literalOsPath "kservices5" </> literalOsPath "ServiceMenus"
createDirectoryIfMissing True kdeServiceMenusdir
- writeFile (fromOsPath (kdeServiceMenusdir </> literalOsPath "git-annex.desktop"))
+ writeFileString (kdeServiceMenusdir </> literalOsPath "git-annex.desktop")
(kdeDesktopFile actions)
where
genNautilusScript scriptdir action =
]
scriptname action = "git-annex " ++ action
installscript f c = whenM (safetoinstallscript f) $ do
- writeFile (fromOsPath f) c
+ writeFileString f c
modifyFileMode f $ addModes [ownerExecuteMode]
safetoinstallscript f = catchDefaultIO True $
elem (encodeBS autoaddedcomment) . fileLines'
installAutoStart command file = do
#ifdef darwin_HOST_OS
createDirectoryIfMissing True (parentDir file)
- writeFile (fromOsPath file) $ genOSXAutoStartFile osxAutoStartLabel command
+ writeFileString file $ genOSXAutoStartFile osxAutoStartLabel command
["assistant", "--autostart"]
#else
writeDesktopMenuFile (fdoAutostart command) file
r <- Git.Config.read =<< Git.Construct.fromPath repo
waiturl $ gitAnnexUrlFile r
waiturl urlfile = do
- v <- tryIO $ readFile (fromOsPath urlfile)
+ v <- tryIO $ readFileString urlfile
case v of
Left _ -> delayed $ waiturl urlfile
Right url -> ifM (assistantListening url)
unless ok $
giveup "ssh-keygen failed"
SshKeyPair
- <$> readFile (fromOsPath (dir </> literalOsPath "key.pub"))
- <*> readFile (fromOsPath (dir </> literalOsPath "key"))
+ <$> readFileString (dir </> literalOsPath "key.pub")
+ <*> readFileString (dir </> literalOsPath "key")
{- Installs a ssh key pair, and sets up ssh config with a mangled hostname
- that will enable use of the key. This way we avoid changing the user's
writeFileProtected (sshdir </> sshPrivKeyFile sshdata)
(sshPrivKey sshkeypair)
unlessM (doesFileExist $ sshdir </> sshPubKeyFile sshdata) $
- writeFile (fromOsPath (sshdir </> sshPubKeyFile sshdata))
+ writeFileString (sshdir </> sshPubKeyFile sshdata)
(sshPubKey sshkeypair)
setSshConfig sshdata
setupSshKeyPair :: SshData -> IO (SshData, SshKeyPair)
setupSshKeyPair sshdata = do
sshdir <- sshDir
- mprivkey <- catchMaybeIO $ readFile (fromOsPath (sshdir </> sshPrivKeyFile sshdata))
- mpubkey <- catchMaybeIO $ readFile (fromOsPath (sshdir </> sshPubKeyFile sshdata))
+ mprivkey <- catchMaybeIO $ readFileString
+ (sshdir </> sshPrivKeyFile sshdata)
+ mpubkey <- catchMaybeIO $ readFileString
+ (sshdir </> sshPubKeyFile sshdata)
keypair <- case (mprivkey, mpubkey) of
(Just privkey, Just pubkey) -> return $ SshKeyPair
{ sshPubKey = pubkey
setSshConfig sshdata config = do
sshdir <- sshDir
createDirectoryIfMissing True sshdir
- let configfile = fromOsPath (sshdir </> literalOsPath "config")
- unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFile configfile) $ do
- appendFile configfile $ unlines $
+ let configfile = sshdir </> literalOsPath "config"
+ unlessM (catchBoolIO $ isInfixOf mangledhost <$> readFileString configfile) $ do
+ appendFileString configfile $ unlines $
[ ""
, "# Added automatically by git-annex"
, "Host " ++ mangledhost
] ++ map (\(k, v) -> "\t" ++ k ++ " " ++ v)
(settings ++ config)
- setSshConfigMode (toOsPath configfile)
+ setSshConfigMode configfile
return $ sshdata
{ sshHostName = T.pack mangledhost
unlessM (boolSystem (fromOsPath program) [Param "version"]) $
giveup "New git-annex program failed to run! Not using."
pf <- programFile
- liftIO $ writeFile (fromOsPath pf) (fromOsPath program)
+ liftIO $ writeFileString pf (fromOsPath program)
#ifdef darwin_HOST_OS
{- OS X uses a dmg, so mount it, and copy the contents into place. -}
deleteFromManifest :: OsPath -> IO ()
deleteFromManifest dir = do
fs <- map (\f -> dir </> toOsPath f) . lines
- <$> catchDefaultIO "" (readFile (fromOsPath manifest))
+ <$> catchDefaultIO "" (readFileString manifest)
mapM_ (removeWhenExistsWith removeFile) fs
removeWhenExistsWith removeFile manifest
removeEmptyRecursive dir
where
addignore = do
liftIO $ unlessM (doesFileExist $ literalOsPath ".gitignore") $
- writeFile ".gitignore" ".thumbnails"
+ writeFileString (literalOsPath ".gitignore") ".thumbnails"
void $ inRepo $
Git.Command.runBool [Param "add", File ".gitignore"]
getLogR = page "Logs" Nothing $ do
logfile <- liftAnnex $ fromRepo gitAnnexDaemonLogFile
logs <- liftIO $ listLogs (fromOsPath logfile)
- logcontent <- liftIO $ concat <$> mapM readFile logs
+ logcontent <- liftIO $ concat <$> mapM (readFileString . toOsPath) logs
$(widgetFile "control/log")
Just f -> customPage (Just About) $ do
-- no sidebar, just pages of legalese..
setTitle "License"
- license <- liftIO $ readFile (fromOsPath f)
+ license <- liftIO $ readFileString f
$(widgetFile "documentation/license")
getRepoGroupR :: Handler Html
import qualified Git.Version
import Utility.SystemDirectory
import Utility.OsPath
+import qualified Utility.FileIO as F
import Control.Monad
import Control.Applicative
setup :: IO ()
setup = do
createDirectoryIfMissing True (toOsPath tmpDir)
- writeFile testFile "test file contents"
+ F.writeFileString (toOsPath testFile) "test file contents"
cleanup :: IO ()
cleanup = removeDirectoryRecursive (toOsPath tmpDir)
, do
programfile <- inDestDir =<< programFile
createDirectoryIfMissing True (parentDir programfile)
- writeFile (fromOsPath programfile) command
+ writeFileString programfile command
)
installUser :: FilePath -> IO ()
, distributionReleasedate = now
, distributionUrgentUpgrade = Just "6.20180626"
}
- liftIO $ writeFile (fromOsPath infofile) $ formatInfoFile d
+ liftIO $ writeFileString infofile $ formatInfoFile d
void $ inRepo $ runBool [Param "add", File (fromOsPath infofile)]
signFile infofile
signFile f
-- Check for out of date info files.
infos <- liftIO $ filter (literalOsPath ".info" `OS.isSuffixOf`)
<$> emptyWhenDoesNotExist (dirContentsRecursive $ literalOsPath "git-annex")
- ds <- liftIO $ forM infos (readish <$$> readFile . fromOsPath)
+ ds <- liftIO $ forM infos (readish <$$> readFileString)
let dis = zip infos ds
let ood = filter outofdate dis
return ood
import Utility.CopyFile
import Utility.SystemDirectory
import qualified Utility.OsString as OS
+import qualified Utility.FileIO as F
mklibs :: OsPath -> a -> IO Bool
mklibs top _installedbins = do
-- Various files used by runshell to set up env vars used by the
-- linker shims.
- writeFile (fromOsPath (top </> literalOsPath "libdirs"))
+ F.writeFileString (top </> literalOsPath "libdirs")
(unlines (map fromOsPath libdirs'))
- writeFile (fromOsPath (top </> literalOsPath "gconvdir")) $
+ F.writeFileString (top </> literalOsPath "gconvdir") $
case gconvlibs of
[] -> ""
(p:_) -> fromOsPath (parentDir p)
link <- relPathDirToFile (top </> exedir) (top <> linker)
unlessM (doesFileExist (top </> exelink)) $
createSymbolicLink (fromOsPath link) (fromOsPath (top </> exelink))
- writeFile (fromOsPath exe) $ unlines
+ F.writeFileString exe $ unlines
[ "#!/bin/sh"
, "exec \"$GIT_ANNEX_DIR/" ++ fromOsPath exelink ++ "\" --library-path \"$GIT_ANNEX_LD_LIBRARY_PATH\" \"$GIT_ANNEX_DIR/shimmed/" ++ fromOsPath base ++ "/" ++ fromOsPath base ++ "\" \"$@\""
]
import Utility.Directory\r
import Utility.SystemDirectory\r
import Utility.OsPath\r
+import qualified Utility.FileIO as F\r
import Build.BundledPrograms\r
\r
main = do\r
mustSucceed "sh" [Param "-c", Param $ "zcat standalone/licences.gz > '" ++ license ++ "'"]\r
webappscript <- vbsLauncher tmpdir "git-annex-webapp" "git annex webapp"\r
autostartscript <- vbsLauncher tmpdir "git-annex-autostart" "git annex assistant --autostart"\r
- let htmlhelp = fromOsPath $ tmpdir </> literalOsPath "git-annex.html"\r
- writeFile htmlhelp htmlHelpText\r
- let gitannexcmd = fromOsPath $ tmpdir </> literalOsPath "git-annex.cmd"\r
- writeFile gitannexcmd "git annex %*"\r
- writeFile nsifile $ makeInstaller\r
+ let htmlhelp = tmpdir </> literalOsPath "git-annex.html"\r
+ F.writeFileString htmlhelp htmlHelpText\r
+ let gitannexcmd = tmpdir </> literalOsPath "git-annex.cmd"\r
+ F.writeFileString gitannexcmd "git annex %*"\r
+ F.writeFileString (toOsPath nsifile) $ makeInstaller\r
gitannex gitannexcmd license htmlhelp (winPrograms ++ magicDLLs') magicShare'\r
[ webappscript, autostartscript ]\r
mustSucceed "makensis" [File nsifile]\r
- box. It expects to be passed the directory where git-annex is installed. -}\r
vbsLauncher :: OsPath -> String -> String -> IO String\r
vbsLauncher tmpdir basename cmd = do\r
- let f = fromOsPath $ tmpdir </> toOsPath (basename ++ ".vbs")\r
- writeFile f $ unlines\r
+ let f = tmpdir </> toOsPath (basename ++ ".vbs")\r
+ F.writeFileString f $ unlines\r
[ "Set objshell=CreateObject(\"Wscript.Shell\")"\r
, "objShell.CurrentDirectory = Wscript.Arguments.item(0)"\r
, "objShell.Run(\"" ++ cmd ++ "\"), 0, False"\r
]\r
- return f\r
+ return (fromOsPath f)\r
\r
gitannexprogram :: FilePath\r
gitannexprogram = "git-annex.exe"\r
installSkelRest :: OsPath -> OsPath -> Bool -> IO ()
#ifdef darwin_HOST_OS
installSkelRest _topdir basedir _hwcaplibs = do
- plist <- lines <$> readFile "standalone/osx/Info.plist.template"
+ plist <- lines <$> F.readFileString (literalOsPath "standalone/osx/Info.plist.template")
version <- getVersion
- writeFile (fromOsPath (basedir </> literalOsPath "Contents" </> literalOsPath "Info.plist"))
+ F.writeFileString (basedir </> literalOsPath "Contents" </> literalOsPath "Info.plist")
(unlines (map (expandversion version) plist))
where
expandversion v l = replace "GIT_ANNEX_VERSION" v l
#else
installSkelRest topdir _basedir hwcaplibs = do
- runshell <- lines <$> readFile "standalone/linux/skel/runshell"
+ runshell <- lines <$> F.readFileString (literalOsPath "standalone/linux/skel/runshell")
-- GIT_ANNEX_PACKAGE_INSTALL can be set by a distributor and
-- runshell will be modified
gapi <- getEnv "GIT_ANNEX_PACKAGE_INSTALL"
- writeFile (fromOsPath (topdir </> literalOsPath "runshell"))
+ F.writeFileString (topdir </> literalOsPath "runshell")
(unlines (map (expandrunshell gapi) runshell))
modifyFileMode
(topdir </> literalOsPath "runshell")
{- Tests the system and generates SysConfig. -}
{-# OPTIONS_GHC -fno-warn-tabs #-}
+{-# LANGUAGE OverloadedStrings #-}
module Build.TestConfig where
import Utility.SafeCommand
import Utility.SystemDirectory
import Utility.OsPath
+import qualified Utility.FileIO as F
import System.IO
valuetype (MaybeBoolConfig _) = "Maybe Bool"
writeSysConfig :: [Config] -> IO ()
-writeSysConfig config = writeFile "Build/SysConfig" body
+writeSysConfig config = F.writeFileString (literalOsPath "Build/SysConfig") body
where
body = unlines $ header ++ map show config ++ footer
header = [
ifM (inSearchPath command)
( return $ Config k $ MaybeStringConfig $ Just command
, do
- r <- getM find ["/usr/sbin", "/sbin", "/usr/local/sbin"]
+ r <- getM find
+ [ literalOsPath "/usr/sbin"
+ , literalOsPath "/sbin"
+ , literalOsPath "/usr/local/sbin"
+ ]
return $ Config k $ MaybeStringConfig r
)
where
find d =
- let f = toOsPath d </> toOsPath command
+ let f = d </> toOsPath command
in ifM (doesFileExist f)
( return (Just (fromOsPath f))
, return Nothing
getChangelogVersion :: IO Version
getChangelogVersion = do
- changelog <- readFile "CHANGELOG"
+ changelog <- F.readFileString (literalOsPath "CHANGELOG")
let verline = takeWhile (/= '\n') changelog
return $ middle (words verline !! 1)
where
runFuzzAction (FuzzAdd (FuzzFile f)) = do
createWorkTreeDirectory (parentDir (toOsPath f))
n <- liftIO (getStdRandom random :: IO Int)
- liftIO $ writeFile f $ show n ++ "\n"
+ liftIO $ writeFileString (toOsPath f) $ show n ++ "\n"
runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $
removeWhenExistsWith removeFile (toOsPath f)
runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $
next $ return True
debugfeedcontent tmpf msg = do
- feedcontent <- liftIO $ readFile tmpf
+ feedcontent <- liftIO $ readFileString (toOsPath tmpf)
fastDebug "Command.ImportFeed" $ unlines
[ "start of feed content"
, feedcontent
checkFeedBroken' :: URLString -> OsPath -> Annex Bool
checkFeedBroken' url f = do
prev <- maybe Nothing readish
- <$> liftIO (catchMaybeIO $ readFile (fromOsPath f))
+ <$> liftIO (catchMaybeIO $ readFileString f)
now <- liftIO getCurrentTime
case prev of
Nothing -> do
<$> fromRepo gitAnnexDir
<*> pure (literalOsPath "map.dot")
- liftIO $ writeFile (fromOsPath file) (drawMap rs trustmap umap)
+ liftIO $ writeFileString file (drawMap rs trustmap umap)
next $
ifM (Annex.getRead Annex.fast)
( runViewer file []
let st = emptySimState rng (fromOsPath simdir)
case simfile of
Nothing -> startup simdir st []
- Just f -> liftIO (readFile f) >>= \c ->
+ Just f -> liftIO (readFileString (toOsPath f)) >>= \c ->
case parseSimFile c of
Left err -> giveup err
Right cs -> startup simdir st cs
createAnnexDirectory $ parentDir f
cfg <- getCfg
descs <- uuidDescriptions
- liftIO $ writeFile (fromOsPath f) $ genCfg cfg descs
+ liftIO $ writeFileString f $ genCfg cfg descs
vicfg cfg f
stop
liftIO $ removeWhenExistsWith removeFile f
case r of
Left s -> do
- liftIO $ writeFile (fromOsPath f) s
+ liftIO $ writeFileString f s
vicfg curcfg f
Right newcfg -> setCfg curcfg newcfg
where
( if isJust (listenAddress o) || isJust (listenPort o)
then giveup "The assistant is already running, so --listen and --port cannot be used."
else do
- url <- liftIO . readFile . fromOsPath
+ url <- liftIO . readFileString
=<< fromRepo gitAnnexUrlFile
liftIO $ if isJust listenAddress'
then putStrLn url
noAnnexFileContent :: Maybe OsPath -> IO (Maybe String)
noAnnexFileContent repoworktree = case repoworktree of
Nothing -> return Nothing
- Just wt -> catchMaybeIO (readFile (fromOsPath (wt </> literalOsPath ".noannex")))
+ Just wt -> catchMaybeIO (readFileString (wt </> literalOsPath ".noannex"))
readAutoStartFile = do
f <- autoStartFile
filter valid . nub . map (dropTrailingPathSeparator . toOsPath) . lines
- <$> catchDefaultIO "" (readFile (fromOsPath f))
+ <$> catchDefaultIO "" (readFileString f)
where
-- Ignore any relative paths; some old buggy versions added eg "."
valid = isAbsolute
when (dirs' /= dirs) $ do
f <- autoStartFile
createDirectoryIfMissing True (parentDir f)
- viaTmp (writeFile . fromRawFilePath . fromOsPath) f
+ viaTmp writeFileString f
(unlines (map fromOsPath dirs'))
{- Adds a directory to the autostart file. If the directory is already
lf <- Annex.fromRepo Git.attributesLocal
ls <- liftIO $ catchDefaultIO [] $
map decodeBS . fileLines' <$> F.readFile' lf
- liftIO $ writeFile (fromOsPath lf) $ unlines $
+ liftIO $ writeFileString lf $ unlines $
filter (\l -> l `notElem` stdattr && not (null l)) ls
unsetConfig (ConfigKey "filter.annex.smudge")
unsetConfig (ConfigKey "filter.annex.clean")
( return mempty
, do
gitindex <- inRepo currentIndexFile
- indexcache <- fromOsPath <$> calcRepo' gitAnnexKeysDbIndexCache
+ indexcache <- calcRepo' gitAnnexKeysDbIndexCache
withTSDelta (liftIO . genInodeCache gitindex) >>= \case
Just cur -> readindexcache indexcache >>= \case
Nothing -> go cur indexcache =<< getindextree
lastindexref = Ref "refs/annex/last-index"
readindexcache indexcache = liftIO $ maybe Nothing readInodeCache
- <$> catchMaybeIO (readFile indexcache)
+ <$> catchMaybeIO (readFileString indexcache)
getoldtree = fromMaybe emptyTree <$> inRepo (Git.Ref.sha lastindexref)
(Just (fromRef oldtree))
(fromRef newtree)
(procdiff mdfeeder)
- liftIO $ writeFile indexcache $ showInodeCache cur
+ liftIO $ writeFileString indexcache $ showInodeCache cur
-- Storing the tree in a ref makes sure it does not
-- get garbage collected, and is available to diff
-- against next time.
adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation)
adjustGitDirFile' loc@(Local {}) = do
let gd = gitdir loc
- c <- firstLine <$> catchDefaultIO "" (readFile (fromOsPath gd))
+ c <- firstLine <$> catchDefaultIO "" (readFileString gd)
if gitdirprefix `isPrefixOf` c
then do
top <- takeDirectory <$> absPath gd
f = hookFile h r
go = do
-- On Windows, using a ByteString as the file content
- -- avoids the newline translation done by writeFile.
+ -- avoids the newline translation done by writeFileString.
-- Hook scripts on Windows could use CRLF endings, but
-- they typically use unix newlines, which does work there
-- and makes the repository more portable.
expectedContent :: Hook -> Repo -> IO ExpectedContent
expectedContent h r = do
- -- Note that on windows, this readFile does newline translation,
+ -- Note that on windows, this readFileString does newline translation,
-- and so a hook file that has CRLF will be treated the same as one
-- that has LF. That is intentional, since users may have a reason
-- to prefer one or the other.
- content <- readFile $ fromOsPath $ hookFile h r
+ content <- readFileString $ hookFile h r
return $ if content == hookScript h
then ExpectedContent
else if any (content ==) (hookOldScripts h)
listAlternates :: Repo -> IO [FilePath]
listAlternates r = catchDefaultIO [] $
- lines <$> readFile (fromOsPath alternatesfile)
+ lines <$> readFileString alternatesfile
where
alternatesfile = objectsDir r </> literalOsPath "info" </> literalOsPath "alternates"
let dest = gitd </> toOsPath (fromRef' ref)
createDirectoryUnder [gitd] (parentDir dest)
unlessM (doesFileExist dest) $
- writeFile (fromOsPath dest) (fromRef sha)
+ writeFileString dest (fromRef sha)
packedRefsFile :: Repo -> OsPath
packedRefsFile r = localGitDir r </> literalOsPath "packed-refs"
preRepair g = do
unlessM (validhead <$> catchDefaultIO "" (decodeBS <$> safeReadFile headfile)) $ do
removeWhenExistsWith removeFile headfile
- writeFile (fromOsPath headfile) "ref: refs/heads/master"
+ writeFileString headfile "ref: refs/heads/master"
explodePackedRefsFile g
unless (repoIsLocalBare g) $
void $ tryIO $ allowWrite $ indexFile g
writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c
where
writelog tmp c' = do
- liftIO $ writeFile (fromOsPath tmp) c'
+ liftIO $ writeFileString tmp c'
setAnnexFilePerm tmp
-- | Runs the action with a handle connected to a temp file.
readFsckResults u = do
logfile <- fromRepo $ gitAnnexFsckResultsLog u
liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $
- deserializeFsckResults <$> readFile (fromOsPath logfile)
+ deserializeFsckResults <$> readFileString logfile
deserializeFsckResults :: String -> FsckResults
deserializeFsckResults = deserialize . lines
ifM (doesPathExist oldf)
( do
h <- F.openFile oldf AppendMode
- hPutStr h =<< readFile (fromOsPath logf)
+ hPutStr h =<< readFileString logf
hClose h
liftIO $ removeWhenExistsWith removeFile logf
, moveFile logf oldf
getLastRunTimes :: Annex (M.Map ScheduledActivity LocalTime)
getLastRunTimes = do
- f <- fromOsPath <$> fromRepo gitAnnexScheduleState
+ f <- fromRepo gitAnnexScheduleState
liftIO $ fromMaybe M.empty
- <$> catchDefaultIO Nothing (readish <$> readFile f)
+ <$> catchDefaultIO Nothing (readish <$> readFileString f)
setLastRunTime :: ScheduledActivity -> LocalTime -> Annex ()
setLastRunTime activity lastrun = do
-- after it's been created with the right perms by writeTransferInfoFile.
updateTransferInfoFile :: TransferInfo -> OsPath -> IO ()
updateTransferInfoFile info tfile =
- writeFile (fromOsPath tfile) $ writeTransferInfo info
+ writeFileString tfile $ writeTransferInfo info
{- File format is a header line containing the startedTime and any
- bytesComplete value. Followed by a newline and the associatedFile.
recentViews :: Annex [View]
recentViews = do
- f <- fromOsPath <$> fromRepo gitAnnexViewLog
- liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)
+ f <- fromRepo gitAnnexViewLog
+ liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFileString f)
{- Gets the currently checked out view, if there is one.
-
let chunkcount = f ++ Legacy.chunkCount
ifM (check chunkcount)
( do
- chunks <- Legacy.listChunks f <$> readFile chunkcount
+ chunks <- Legacy.listChunks f <$> readFileString (toOsPath chunkcount)
ifM (allM check chunks)
( a chunks , return False )
, do
recorder f s = do
let f' = toOsPath f
void $ tryIO $ allowWrite f'
- writeFile f s
+ writeFileString f' s
void $ tryIO $ preventWrite f'
store :: FilePath -> ChunkSize -> (OsPath -> OsPath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO ()
writeSharedConvergenceSecret :: TahoeConfigDir -> SharedConvergenceSecret -> IO ()
writeSharedConvergenceSecret configdir scs =
- writeFile (fromOsPath (convergenceFile configdir))
+ writeFileString (convergenceFile configdir)
(unlines [scs])
{- The tahoe daemon writes the convergenceFile shortly after it starts
getSharedConvergenceSecret :: TahoeConfigDir -> IO SharedConvergenceSecret
getSharedConvergenceSecret configdir = go (60 :: Int)
where
- f = fromOsPath $ convergenceFile configdir
+ f = convergenceFile configdir
go n
- | n == 0 = giveup $ "tahoe did not write " ++ f ++ " after 1 minute. Perhaps the daemon failed to start?"
+ | n == 0 = giveup $ "tahoe did not write " ++ fromOsPath f ++ " after 1 minute. Perhaps the daemon failed to start?"
| otherwise = do
- v <- catchMaybeIO (readFile f)
+ v <- catchMaybeIO (readFileString f)
case v of
Just s | "\n" `isSuffixOf` s || "\r" `isSuffixOf` s ->
return $ takeWhile (`notElem` ("\n\r" :: String)) s
#ifdef WITH_MAGICMIME
git "config" ["annex.largefiles", "mimeencoding=binary"]
"git config annex.largefiles"
- writeFile "binary" "\127"
- writeFile "text" "test\n"
+ writeFileString (literalOsPath "binary") "\127"
+ writeFileString (literalOsPath "text") "test\n"
git_annex "add" ["binary", "text"]
"git-annex add with mimeencoding in largefiles"
git_annex "sync" ["--no-content"]
changecontent annexedfile
git "add" [annexedfile] "add of modified file"
runchecks [checkregularfile, checkwritable] annexedfile
- c <- readFile annexedfile
+ c <- readFileString (toOsPath annexedfile)
assertEqual "content of modified file" c (changedcontent annexedfile)
git_annex_shouldfail "drop" [annexedfile]
"drop with no known copy of modified file should not be allowed"
then git_annex "pre-commit" [] "pre-commit"
else git "commit" ["-q", "-m", "contentchanged"] "git commit of edited file"
runchecks [checkregularfile, checkwritable] annexedfile
- c <- readFile annexedfile
+ c <- readFileString (toOsPath annexedfile)
assertEqual "content of modified file" c (changedcontent annexedfile)
git_annex_shouldfail "drop" [annexedfile] "drop no known copy of modified file should not be allowed"
git "mv" [annexedfile, subdir] "git mv"
git_annex "fix" [newfile] "fix of moved file"
runchecks [checklink, checkunwritable] newfile
- c <- readFile newfile
+ c <- readFileString (toOsPath newfile)
assertEqual "content of moved file" c (content annexedfile)
where
subdir = "s"
annexed_present sha1annexedfile
if usegitattributes
then do
- writeFile ".gitattributes" "* annex.backend=SHA1"
+ writeFileString (literalOsPath ".gitattributes")
+ "* annex.backend=SHA1"
git_annex "migrate" [sha1annexedfile]
"migrate sha1annexedfile"
git_annex "migrate" [annexedfile]
checkbackend sha1annexedfile backendSHA1
-- check that reversing a migration works
- writeFile ".gitattributes" "* annex.backend=SHA256"
+ writeFileString (literalOsPath ".gitattributes")
+ "* annex.backend=SHA256"
git_annex "migrate" [sha1annexedfile] "migrate sha1annexedfile"
git_annex "migrate" [annexedfile] "migrate annexedfile"
annexed_present annexedfile
length v == 1
@? (what ++ " too many variant files in: " ++ show v)
conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l)
- s <- catchMaybeIO $ readFile $ fromOsPath $
+ s <- catchMaybeIO $ readFileString $
toOsPath d </> toOsPath conflictor
s == Just nonannexed_content
@? (what ++ " wrong content for nonannexed file: " ++ show s)
dircontains "import" (content "newimport3")
where
dircontains f v = do
- let df = fromOsPath (literalOsPath "dir" </> stringToOsPath f)
- ((v==) <$> readFile df)
- @? ("did not find expected content of " ++ df)
+ let df = literalOsPath "dir" </> stringToOsPath f
+ ((v==) <$> readFileString df)
+ @? ("did not find expected content of " ++ fromOsPath df)
writedir f = writecontent (fromOsPath (literalOsPath "dir" </> stringToOsPath f))
-- When on an adjusted branch, this updates the master branch
-- to match it, which is necessary since the master branch is going
testexport
where
dircontains f v = do
- let df = fromOsPath (literalOsPath "dir" </> toOsPath f)
- ((v==) <$> readFile df)
- @? ("did not find expected content of " ++ df)
+ let df = literalOsPath "dir" </> toOsPath f
+ ((v==) <$> readFileString df)
+ @? ("did not find expected content of " ++ fromOsPath df)
subdir = "subdir"
subannexedfile = fromOsPath $
checkcontent :: FilePath -> Assertion
checkcontent f = do
- c <- Utility.Exception.catchDefaultIO "could not read file" $ readFile f
+ c <- Utility.Exception.catchDefaultIO "could not read file" $ readFileString (toOsPath f)
assertEqual ("checkcontent " ++ f) (content f) c
checkunwritable :: FilePath -> Assertion
checkdangling f = ifM (annexeval Config.crippledFileSystem)
( return () -- probably no real symlinks to test
, do
- r <- tryIO $ readFile f
+ r <- tryIO $ readFileString (toOsPath f)
case r of
Left _ -> return () -- expected; dangling link
Right _ -> assertFailure $ f ++ " was not a dangling link as expected"
writecontent f c = go (10000000 :: Integer)
where
go ticsleft = do
- oldmtime <- catchMaybeIO $ getModificationTime (toOsPath f)
- writeFile f c
- newmtime <- getModificationTime (toOsPath f)
+ let f' = toOsPath f
+ oldmtime <- catchMaybeIO $ getModificationTime f'
+ writeFileString f' c
+ newmtime <- getModificationTime f'
if Just newmtime == oldmtime
then do
threadDelay 100000
inject :: OsPath -> OsPath -> Annex ()
inject source dest = do
old <- fromRepo olddir
- new <- liftIO (readFile $ fromOsPath $ old </> source)
+ new <- liftIO $ readFileString (old </> source)
Annex.Branch.change (Annex.Branch.RegardingUUID []) dest $ \prev ->
encodeBL $ unlines $ nub $ lines (decodeBL prev) ++ lines new
whenM (doesFileExist attributes) $ do
c <- map decodeBS . fileLines'
<$> F.readFile' attributes
- liftIO $ viaTmp (writeFile . fromOsPath) attributes
+ liftIO $ viaTmp writeFileString attributes
(unlines $ filter (`notElem` attrLines) c)
Git.Command.run [Param "add", File (fromOsPath attributes)] repo
<$> catchDefaultIO "" (F.readFile' lf)
let ls' = removedotfilter ls
when (ls /= ls') $
- liftIO $ writeFile (fromOsPath lf) (unlines ls')
+ liftIO $ writeFileString lf (unlines ls')
where
removedotfilter ("* filter=annex":".* !filter":rest) =
"* filter=annex" : removedotfilter rest
unlessM (isNothing <$> checkDaemon pidfile)
alreadyRunning
pid <- getPID
- writeFile (fromOsPath pidfile) (show pid)
+ writeFileString pidfile (show pid)
lckfile <- winLockFile pid pidfile
- writeFile (fromOsPath lckfile) ""
+ writeFileString lckfile ""
void $ lockExclusive lckfile
#endif
cleanup Nothing = return ()
go (Just fd) = catchDefaultIO Nothing $ do
locked <- getLock fd (ReadLock, AbsoluteSeek, 0, 0)
- p <- readish <$> readFile (fromOsPath pidfile)
+ p <- readish <$> readFileString pidfile
return (check locked p)
go Nothing = return Nothing
"; expected " ++ show pid ++ " )"
#else
checkDaemon pidfile = maybe (return Nothing) (check . readish)
- =<< catchMaybeIO (readFile (fromOsPath pidfile))
+ =<< catchMaybeIO (readFileString pidfile)
where
check Nothing = return Nothing
check (Just pid) = do
- When possible, this is done using the umask.
-
- On a filesystem that does not support file permissions, this is the same
- - as writeFile.
+ - as writeFileString.
-}
writeFileProtected :: OsPath -> String -> IO ()
writeFileProtected file content = writeFileProtected' file
writeDesktopMenuFile :: DesktopEntry -> OsPath -> IO ()
writeDesktopMenuFile d file = do
createDirectoryIfMissing True (takeDirectory file)
- writeFile (fromOsPath file) $ buildDesktopMenuFile d
+ writeFileString file $ buildDesktopMenuFile d
{- Path to use for a desktop menu file, in either the systemDataDir or
- the userDataDir -}
writeSentinalFile :: SentinalFile -> IO ()
writeSentinalFile s = do
F.writeFile' (sentinalFile s) mempty
- maybe noop (writeFile (fromOsPath (sentinalCacheFile s)) . showInodeCache)
+ maybe noop (writeFileString (sentinalCacheFile s) . showInodeCache)
=<< genInodeCache (sentinalFile s) noTSDelta
data SentinalStatus = SentinalStatus
Just new -> return $ calc old new
where
loadoldcache = catchDefaultIO Nothing $
- readInodeCache <$> readFile (fromOsPath (sentinalCacheFile s))
+ readInodeCache <$> readFileString (sentinalCacheFile s)
gennewcache = genInodeCache (sentinalFile s) noTSDelta
calc (InodeCache (InodeCachePrim oldinode oldsize oldmtime)) (InodeCache (InodeCachePrim newinode newsize newmtime)) =
SentinalStatus (not unchanged) tsdelta
import Utility.Tmp
import Utility.RawFilePath
import Utility.OsPath
+import qualified Utility.FileIO as F
import qualified Utility.LockFile.Posix as Posix
import System.IO
readPidLock :: PidLockFile -> IO (Maybe PidLock)
readPidLock lockfile = (readish =<<)
- <$> catchMaybeIO (readFile (fromOsPath lockfile))
+ <$> catchMaybeIO (F.readFileString lockfile)
-- To avoid races when taking over a stale pid lock, a side lock is used.
-- This is a regular posix exclusive lock.
(CloseOnExecFlag True)
fdToHandle fd
let cleanup = hClose
- let go h = readFile (fromOsPath src) >>= hPutStr h
+ let go h = F.readFileString src >>= hPutStr h
bracket setup cleanup go
getFileStatus dest'
where
fileLines' = S8.lines
#endif
--- One windows, writeFile does NewlineMode translation,
+-- On windows, writeFile does NewlineMode translation,
-- adding CR before LF. When converting to ByteString, use this to emulate that.
linesFile :: L.ByteString -> L.ByteString
#ifndef mingw32_HOST_OS
#ifndef mingw32_HOST_OS
defcmd
#else
- l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFile (fromOsPath f)
+ l <- catchDefaultIO Nothing $ headMaybe . lines <$> readFileString f
case l of
Just ('#':'!':rest) -> case words rest of
[] -> defcmd
let loc = ioeGetLocation e ++ " template " ++ decodeBS (fromOsPath template)
in annotateIOError e loc Nothing Nothing
-{- Runs an action like writeFile, writing to a temp file first and
+{- Runs an action like writeFileString, writing to a temp file first and
- then moving it into place. The temp file is stored in the same
- directory as the final file to avoid cross-device renames.
-
- While this uses a temp file, the file will end up with the same
- - mode as it would when using writeFile, unless the writer action changes
- - it.
+ - mode as it would when using writeFileString, unless the writer action
+ - changes it.
-}
viaTmp :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m ()
viaTmp a file content = bracketIO setup cleanup use
addHiddenService :: AppName -> UserID -> UniqueIdent -> IO (OnionAddress, OnionPort)
addHiddenService appname uid ident = do
prepHiddenServiceSocketDir appname uid ident
- ls <- lines <$> (readFile . fromOsPath =<< findTorrc)
+ ls <- lines <$> (readFileString =<< findTorrc)
let portssocks = mapMaybe (parseportsock . separate isSpace) ls
case filter (\(_, s) -> s == fromOsPath sockfile) portssocks of
((p, _s):_) -> waithiddenservice 1 p
let newport = fromMaybe (error "internal") $ headMaybe $
filter (`notElem` map fst portssocks) highports
torrc <- findTorrc
- writeFile (fromOsPath torrc) $ unlines $
+ writeFileString torrc $ unlines $
ls ++
[ ""
, "HiddenServiceDir " ++ fromOsPath (hiddenServiceDir appname uid ident)
waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort)
waithiddenservice 0 _ = giveup "tor failed to create hidden service, perhaps the tor service is not running"
waithiddenservice n p = do
- v <- tryIO $ readFile $ fromOsPath $
+ v <- tryIO $ readFileString $
hiddenServiceHostnameFile appname uid ident
case v of
Right s | ".onion\n" `isSuffixOf` s ->
getHiddenServiceSocketFile :: AppName -> UserID -> UniqueIdent -> IO (Maybe OsPath)
getHiddenServiceSocketFile _appname uid ident =
parse . map words . lines <$> catchDefaultIO ""
- (readFile . fromOsPath =<< findTorrc)
+ (readFileString =<< findTorrc)
where
parse [] = Nothing
parse (("HiddenServiceDir":hsdir:[]):("HiddenServicePort":_hsport:hsaddr:[]):rest)
projects / git-annex.git / commitdiff